unit Coco;

interface

uses Classes,CocoAncestor,CocoGenerator,
SysUtils,CharSets, CRTypes, CRT, CRA;

type


  TCocoScanner = class(TCocoRScanner)
  public
    procedure SkipIgnoreSet; override;
    procedure ScanSym(state: Integer; var sym: Integer); override;
    function SkipComments(ind: Integer): Boolean; override;
  end;


  TCoco = class(TCocoGenerator)
  private              
    tokenString: String;
    SkipWarnSuppression: Boolean;
 
  protected

    procedure _Coco;
    procedure _TemplateVar;
    procedure _SetDecl;
    procedure _TokenDecl(typ: TSymbolType);
    procedure _HomographString;
    procedure _CommentDecl;
    procedure _Set(var cset: TCharSet);
    procedure _Production;
    procedure _SimSet(var cset: TCharSet);
    procedure _SingleChar(var n: Integer);
    procedure _Sym(var name: String; var isID: Boolean);
    procedure _TokenExpr(var nL1,nR1: TNode);
    procedure _SemText(pos: PSymbol);
    procedure _TokenTerm(var nL1,nR1: TNode);
    procedure _TokenFactor(var nL,nR: TNode);
    procedure _Attribs(pos: PSymbol);
    procedure _Expression(var nL1,nR1: TNode);
    procedure _Term(var nL1,nR1: TNode);
    procedure _Factor(var nL,nR: TNode);

  public
            
    tab: TSymbolTable;
    dfa: TAutomaton;
    genScanner: Boolean;


    procedure ProcessPragmas; override;
    function  ErrorMessage(ErrorType,ErrorCode: Integer; const data: string): String; override;
    function  TokenToString(n: Integer): String; override;
    function  CreateScanner: TBaseScanner; override;
    function Execute: Boolean; override;

    constructor Create(AOwner: TComponent); override;

  end;

implementation

const

	identSym = 1;	stringSym = 2;	badstringSym = 3;	numberSym = 4;	COMPILERSym = 5;
	FRAMESym = 6;	ENDSym = 7;	CHARACTERSSym = 8;	TOKENSSym = 9;	HOMOGRAPHSSym = 10;
	PRAGMASSym = 11;	COMMENTSSym = 12;	IGNORECASESym = 13;	IGNORESym = 14;	PRODUCTIONSSym = 15;
	_pointSym = 16;	_equalSym = 17;	_plusSym = 18;	_minusSym = 19;	_point_pointSym = 20;
	ANYSym = 21;	CHRSym = 22;	_lparenSym = 23;	_rparenSym = 24;	HOMOGRAPHSym = 25;
	_barSym = 26;	CONTEXTSym = 27;	_lbrackSym = 28;	_rbrackSym = 29;	_lbraceSym = 30;
	_rbraceSym = 31;	FROMSym = 32;	TOSym = 33;	NESTEDSym = 34;	_lessSym = 35;
	_greaterSym = 36;	_lparen_pointSym = 37;	_point_rparenSym = 38;	IFSym = 39;	WEAKSym = 40;
	SYNCSym = 41;	_NOSYMB = 42;	_slash_starSym = 43;	WarnPragmaSym = 44;	IGnoreWarnPragmaSym = 45;


var CocoSymSets: TSetArray;


var
  CocoST: TStartTable = nil;
  CocoLiterals: TStringList = nil;

{ TCocoScanner }

procedure TCocoScanner.ScanSym(state: Integer; var sym: Integer);
begin
 while True do
 begin
  NextCh;
  case state of
	 1:
		if ((CurrInputCh>='0')and(CurrInputCh<='9'))or((CurrInputCh>='A')and(CurrInputCh<='Z'))or(CurrInputCh='_')or((CurrInputCh>='a')and(CurrInputCh<='z')) then
		else begin
		  sym := identSym;
		  CheckLiteral(sym);
		  Exit;
		end;
	 2:
		begin
		  sym := stringSym;
		  Exit;
		end;
	 3:
		begin
		  sym := badstringSym;
		  Exit;
		end;
	 4:
		if ((CurrInputCh>='0')and(CurrInputCh<='9')) then
		else begin
		  sym := numberSym;
		  Exit;
		end;
	 5:
		if (CurrInputCh = '*') then
		  state := 6
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	 6:
		begin
		  sym := _slash_starSym;
		  Exit;
		end;
	 7:
		if (CurrInputCh = '}') then
		  state := 8
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	 8:
		begin
		  sym := WarnPragmaSym;
		  Exit;
		end;
	 9:
		if (CurrInputCh = '}') then
		  state := 10
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	10:
		begin
		  sym := IGnoreWarnPragmaSym;
		  Exit;
		end;
	11:
		if not(((CurrInputCh>=#1)and(CurrInputCh<=#31))or(CurrInputCh='"')) then
		else if (CurrInputCh=#10)or(CurrInputCh=#13) then
		  state := 3
		else if (CurrInputCh = '"') then
		  state := 2
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	12:
		if not(((CurrInputCh>=#1)and(CurrInputCh<=#31))or(CurrInputCh='''')) then
		else if (CurrInputCh=#10)or(CurrInputCh=#13) then
		  state := 3
		else if (CurrInputCh = '''') then
		  state := 2
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	13:
		if (CurrInputCh = '+') then
		  state := 14
		else if (CurrInputCh = '-') then
		  state := 7
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	14:
		if (CurrInputCh = '}') then
		  state := 8
		else if (CurrInputCh = '+') then
		  state := 9
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	15:
		begin
		  sym := _equalSym;
		  Exit;
		end;
	16:
		begin
		  sym := _plusSym;
		  Exit;
		end;
	17:
		begin
		  sym := _minusSym;
		  Exit;
		end;
	18:
		begin
		  sym := _point_pointSym;
		  Exit;
		end;
	19:
		begin
		  sym := _rparenSym;
		  Exit;
		end;
	20:
		begin
		  sym := _barSym;
		  Exit;
		end;
	21:
		begin
		  sym := _lbrackSym;
		  Exit;
		end;
	22:
		begin
		  sym := _rbrackSym;
		  Exit;
		end;
	23:
		begin
		  sym := _rbraceSym;
		  Exit;
		end;
	24:
		begin
		  sym := _lessSym;
		  Exit;
		end;
	25:
		begin
		  sym := _greaterSym;
		  Exit;
		end;
	26:
		begin
		  sym := _lparen_pointSym;
		  Exit;
		end;
	27:
		begin
		  sym := _point_rparenSym;
		  Exit;
		end;
	28:
		if (CurrInputCh = 'W') then
		  state := 13
		else begin
		  sym := _lbraceSym;
		  Exit;
		end;
	29:
		if (CurrInputCh = '.') then
		  state := 18
		else if (CurrInputCh = ')') then
		  state := 27
		else begin
		  sym := _pointSym;
		  Exit;
		end;
	30:
		if (CurrInputCh = '.') then
		  state := 26
		else begin
		  sym := _lparenSym;
		  Exit;
		end;
  
    else begin
      if CurrInputCh=#0 then
           sym := _EOFSYMB
      else sym := _NOSYMB;
      Exit;
    end;
  end;
 end;
end;


procedure TCocoScanner.SkipIgnoreSet;
begin
  while (CurrInputCh = ' ') or 
    ( (CurrInputCh=#9)or(CurrInputCh=#10)or(CurrInputCh=#13) )
  do NextCh;
end;


function TCocoScanner.SkipComments(ind: Integer): Boolean;
begin
  Result := True;
  case ind of
    _slash_starSym: SkipNestedComment(#39'/*'#39,'*/');

    else Result := False;
  end;
end;



{ TCoco }


procedure TCoco._Coco;
                                   var gramName : String; 
begin
                                   SkipWarnSuppression := False; 
  Expect(COMPILERSym);
                                   genScanner := True;  
  Expect(identSym);
                                   gramName := LexName; 
  if (CurrentInputSymbol=FRAMESym) then
  begin
    Get;
    if (CurrentInputSymbol=stringSym) then
    begin
      Get;
                                   tab.FrameName := LexString; 
    end;
    while (CurrentInputSymbol=identSym) do
    begin
      _TemplateVar;
    end;
    ExpectWeak(ENDSym,0);
  end;
  while InSet(CurrentInputSymbol,1) do
  begin
    while not InSet(CurrentInputSymbol,2) do
    begin SynError(1); Get; end;
    if (CurrentInputSymbol=CHARACTERSSym) then
    begin
         Get;
         while (CurrentInputSymbol=identSym) do
         begin
           _SetDecl;
         end;
    end
    else if (CurrentInputSymbol=TOKENSSym) then
    begin
         Get;
         while (CurrentInputSymbol in [identSym, stringSym]) do
         begin
           _TokenDecl(stTerminal);
         end;
    end
    else if (CurrentInputSymbol=HOMOGRAPHSSym) then
    begin
         Get;
         while (CurrentInputSymbol=stringSym) do
         begin
           _HomographString;
         end;
    end
    else if (CurrentInputSymbol=PRAGMASSym) then
    begin
         Get;
         while (CurrentInputSymbol in [identSym, stringSym]) do
         begin
           _TokenDecl(stPragma);
         end;
    end
    else if (CurrentInputSymbol=COMMENTSSym) then
    begin
         Get;
         _CommentDecl;
    end
    else if (CurrentInputSymbol=IGNORECASESym) then
    begin
         Get;
                                   tab.ignoreCase := True; 
    end
    else if (CurrentInputSymbol=IGNORESym) then
    begin
         Get;
         _Set(tab.IgnoredChars);
    end
    ;
  end;
  while not (CurrentInputSymbol in [_EOFSYMB, PRODUCTIONSSym]) do
  begin SynError(1); Get; end;
  Expect(PRODUCTIONSSym);
                                   if genScanner then dfa.MakeDeterministic;
                                   tab.DeleteNodes;
                                
  while (CurrentInputSymbol=identSym) do
  begin
    _Production;
  end;
  Expect(ENDSym);
  Expect(identSym);
                                   if gramName <> LexName then
                                     SemError(209);
                                   tab.gramSy := TNtSymbol(tab.Symbols[gramName]);
                                   if tab.gramSy = nil then
                                     SemError(210)
                                   else if tab.gramSy.hasAttrPos then
                                       SemError(211);
                                   tab.Finalize;
                                 
  Expect(_pointSym);
end;

procedure TCoco._TemplateVar;
               var name: String; pos: TSymbolRec; 
begin
  Expect(identSym);
                             name := LexName; 
  Expect(_equalSym);
  _SemText(@pos);
                             tab.TemplateVars[name] := @pos; 
end;

procedure TCoco._SetDecl;
                                   var name: String; c: Integer; cset: TCharSet; 
begin
  Expect(identSym);
                                   name := LexName; cset := nil;
                                   c := tab.CharClassByName[name];
                                   if c>=0 then SemError(212);
                                 
  Expect(_equalSym);
  _Set(cset);
                                   if cset.IsEmpty then SemError(213);
                                   tab.NewCharClass(name, cset);
                                 
  Expect(_pointSym);
end;

procedure TCoco._TokenDecl(typ: TSymbolType);
 var name: String; isID: Boolean; sym: TSymbol; nL,nR: TNode; 

   procedure ProcLiteral(const lit: String);
   begin
     if tab.literals[lit] <> nil then
       SemError(218);
     tab.literals[lit] := sym;
     dfa.MatchLiteral(lit, sym);
   end;

begin
  _Sym(name, isID);
                                   sym := tab.Symbols[name];
                                   if sym<>nil then SemError(212)
                                   else begin
                                     sym := tab.NewSym(typ, name, CurLine);
                                     sym.kind := tkFixed;
                                   end;
                                   tokenString := '';
                                 
  while not InSet(CurrentInputSymbol,0) do
  begin SynError(2); Get; end;
  if (CurrentInputSymbol=_equalSym) then
  begin
       Get;
       if InSet(CurrentInputSymbol,3) then
       begin
            _TokenExpr(nL,nR);
                                   if not isID then SemError(217);
                                   nR.FinishGraph;
                                   if (tokenString='')or(tokenString='-none-') then
                                     dfa.ConvertToStates(nL, sym)
                                   else ProcLiteral(tokenString);
                                 
       end
       else if (CurrentInputSymbol=HOMOGRAPHSym) then
       begin
            Get;
            Expect(stringSym);
                                   if not isID then SemError(217);
                                   ProcLiteral(LexName);
                                   TtSymbol(sym).homograph := True;
                                 
       end
       else SynError(3);
       Expect(_pointSym);
  end
  else if InSet(CurrentInputSymbol,4) then
  begin
                                   if isID then genScanner := false
                                   else dfa.MatchLiteral(sym.name, sym);
                                 
  end
  else SynError(3);
  if (CurrentInputSymbol=_lparen_pointSym) then
  begin
    _SemText(sym.semPos);
                                   if typ<>stPragma then SemError(219); 
  end;
end;

procedure TCoco._HomographString;
 var name: String; sym: TSymbol; 
begin
  Expect(stringSym);
                                   name := tab.FixStringForToken(LexName);
                                   sym := tab.Symbols[name];
                                   if sym<>nil then SemError(212)
                                   else begin
                                     sym := tab.NewSym(stTerminal, name, CurLine);
                                     sym.kind := tkFixed;
                                   end;
                                   if tab.literals[name] <> nil then
                                     SemError(218);
                                   tab.literals[name] := sym;
                                   dfa.MatchLiteral(name, sym);
                                   TtSymbol(sym).homograph := True;
                                 
end;

procedure TCoco._CommentDecl;
                                  var nested: Boolean; nL1,nR1,nL2,nR2: TNode; 
begin
                                  nested := False; 
  Expect(FROMSym);
  _TokenExpr(nL1,nR1);
  Expect(TOSym);
  _TokenExpr(nL2,nR2);
  if (CurrentInputSymbol=NESTEDSym) then
  begin
    Get;
                                  nested := True; 
  end;
                                  dfa.NewComment(nL1, nL2, nested); 
end;

procedure TCoco._Set(var cset: TCharSet);
                                  var cset2: TCharSet;  
begin
                                   cset2 := nil;
                                   try
                                 
  _SimSet(cset);
  while (CurrentInputSymbol in [_plusSym, _minusSym]) do
  begin
    if (CurrentInputSymbol=_plusSym) then
    begin
         Get;
         _SimSet(cset2);
                                   cset.Unite(cset2);  
    end
    else if (CurrentInputSymbol=_minusSym) then
    begin
         Get;
         _SimSet(cset2);
                                   cset.Subtract(cset2); 
    end
    ;
  end;
                                   finally cset2.Free; end; 
end;

procedure TCoco._Production;
                                  var sym: TSymbol;
                                  nR: TNode;
                                  undef: Boolean;
                                  pos: TSymbolRec;
                                
begin
  Expect(identSym);
                                  sym := tab.Symbols[LexName];
                                  undef := sym = nil;
                                  if undef then
                                     sym := tab.NewSym(stNonterminal, LexName, CurLine)
                                  else begin
                                     if sym.typ = stNonterminal then
                                     begin
                                       if sym.graph <> nil then SemError(212); 
                                     end else SemError(221);
                                     sym.line := CurLine;
                                  end;
                                  ClearSymbol(@pos);
                                
  if (CurrentInputSymbol=_lessSym) then
  begin
    _Attribs(@pos);
  end;
                                  if (not undef)and((pos.Beg<>-1)<>sym.hasAttrPos)  then
                                     SemError(222);
                                  if pos.Beg<>-1 then sym.AttrPos^ := pos;
                                
  if (CurrentInputSymbol=_lparen_pointSym) then
  begin
    _SemText(sym.semPos);
  end;
  ExpectWeak(_equalSym,5);
  _Expression(TNtSymbol(sym).fGraph,nR);
                                              nR.FinishGraph; 
  ExpectWeak(_pointSym,6);
end;

procedure TCoco._SimSet(var cset: TCharSet);
                                   var n1, n2: Integer; 
begin
                                   if cset=nil then cset := TCharSet.Create
                                   else cset.Clear;
                                 
  if (CurrentInputSymbol=identSym) then
  begin
       Get;
                                   n1 := tab.CharClassByName[LexName];
                                   if n1<0 then SemError(214)
                                   else cset.Unite(tab.CharClassSet[n1]);
                                
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                   FillSetByStr(cset,DequotedStr(LexString));  
  end
  else if (CurrentInputSymbol=CHRSym) then
  begin
       _SingleChar(n1);
                                   if n1>=0 then cset.AddChar(n1); 
       if (CurrentInputSymbol=_point_pointSym) then
       begin
         Get;
         _SingleChar(n2);
                                   cset.AddRange(n1,n2);    
       end;
  end
  else if (CurrentInputSymbol=ANYSym) then
  begin
       Get;
                                   cset.Fill; 
  end
  else SynError(4);
end;

procedure TCoco._SingleChar(var n: Integer);
                                   var s: String; 
begin
  Expect(CHRSym);
  Expect(_lparenSym);
  if (CurrentInputSymbol=numberSym) then
  begin
       Get;
                                  
                                   n := StrToIntDef(LexString,-1);
                                   if n<0 then
                                     SemError(215)
                                   else if n > 127 then
                                   begin
                                     SemError(215); n := -1;
                                   end;
                                 
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                   s := LexString;
                                    if Length(s)<>3 then SemError(216);
                                    n := Ord(s[2]);
                                 
  end
  else SynError(5);
  Expect(_rparenSym);
end;

procedure TCoco._Sym(var name: String; var isID: Boolean);
begin
  if (CurrentInputSymbol=identSym) then
  begin
       Get;
                                  isID := True; name := LexName; 
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                  isId := False; name := tab.FixStringForToken(LexName); 
  end
  else SynError(6);
end;

procedure TCoco._TokenExpr(var nL1,nR1: TNode);
                                   var nL2,nR2: TNode; first: Boolean; 
begin
  _TokenTerm(nL1,nR1);
                                   first := True; 
  while WeakSeparator(26,3,7) do
  begin
    _TokenTerm(nL2,nR2);
                                   if first then
                                   begin
                                     tab.MakeFirstAlt(nL1,nR1); first := false;
                                   end;
                                   tab.MakeAlt(nL1,nR1,nL2,nR2);
                                 
  end;
end;

procedure TCoco._SemText(pos: PSymbol);
begin
  Expect(_lparen_pointSym);
                                    pos^ := CurSymbol^; 
  while InSet(CurrentInputSymbol,8) do
  begin
    if InSet(CurrentInputSymbol,9) then
    begin
         Get;
    end
    else if (CurrentInputSymbol=badstringSym) then
    begin
         Get;
                                    SemError(224); 
    end
    else if (CurrentInputSymbol=_lparen_pointSym) then
    begin
         Get;
                                    SemError(225); 
    end
    ;
  end;
  Expect(_point_rparenSym);
                                    Inc(pos^.Beg,2);
                                    pos^.Len := CurSymbol^.Beg - pos^.Beg;
                                  
end;

procedure TCoco._TokenTerm(var nL1,nR1: TNode);
                                  var nL2,nR2: TNode; 
begin
  _TokenFactor(nL1,nR1);
  while InSet(CurrentInputSymbol,3) do
  begin
    _TokenFactor(nL2,nR2);
                                  tab.MakeSeq(nL1,nR1,nL2,nR2); 
  end;
  if (CurrentInputSymbol=CONTEXTSym) then
  begin
    Get;
    Expect(_lparenSym);
    _TokenExpr(nL2,nR2);
                                  tab.SetContextTrans(nL2);
                                  dfa.hasCtxMoves := True;
                                  tab.MakeSeq(nL1,nR1,nL2,nR2);
                                
    Expect(_rparenSym);
  end;
end;

procedure TCoco._TokenFactor(var nL,nR: TNode);
                                  var name: String; isID: Boolean; c: Integer; 
begin
                                  nL := nil; nR := nil; 
  if (CurrentInputSymbol in [identSym, stringSym]) then
  begin
       _Sym(name, isID);
                                  if isID then begin
                                    c := tab.CharClassByName[name];
                                    if c<0 then begin
                                       SemError(220);
                                       c := tab.NewCharClass(name);
                                    end;
                                    nL := tab.NewNode(ntCharClass,nil,CurLine); nL.val := c;
                                    nR := nL;
                                    tokenString := '-none-';
                                  end else begin // str
                                     tab.StrToGraph(name,nL,nR);
                                     if tokenString='' then
                                      tokenString := name
                                     else tokenString := '-none-';
                                 end;
                                 
  end
  else if (CurrentInputSymbol=_lparenSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rparenSym);
  end
  else if (CurrentInputSymbol=_lbrackSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rbrackSym);
                                  tab.MakeOpt(nL,nR);  
  end
  else if (CurrentInputSymbol=_lbraceSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rbraceSym);
                                  tab.MakeIter(nL,nR); 
  end
  else SynError(7);
                                  if nL=nil then // invalid start of TokenFactor
                                  begin nL := tab.NewNode(ntEps, nil, 0); nR := nL; end; 
end;

procedure TCoco._Attribs(pos: PSymbol);
                                  var start: TSymbolRec; 
begin
  Expect(_lessSym);
                                  start := NextSymbol^; 
  while InSet(CurrentInputSymbol,10) do
  begin
    if InSet(CurrentInputSymbol,11) then
    begin
         Get;
    end
    else if (CurrentInputSymbol=badstringSym) then
    begin
         Get;
                                  SemError(223); 
    end
    ;
  end;
  Expect(_greaterSym);
                                  with CurSymbol^ do
                                  if start.Beg <> Beg then
                                  begin
                                    start.Len := Beg - start.Beg;
                                    pos^ := start;
                                  end;
                                
end;

procedure TCoco._Expression(var nL1,nR1: TNode);
                                     var nL2,nR2: TNode; first: Boolean; 
begin
  _Term(nL1,nR1);
                                   first := True; 
  while WeakSeparator(26,12,13) do
  begin
    _Term(nL2,nR2);
                                   if first then
                                   begin
                                     tab.MakeFirstAlt(nL1, nR1);
                                     first := False;
                                   end;
                                   tab.MakeAlt(nL1,nR1,nL2,nR2);
                                 
  end;
end;

procedure TCoco._Term(var nL1,nR1: TNode);
                                   var nL2, nR2: TNode; 
begin
                                   nL1 := nil; nR1 := nil; 
  if InSet(CurrentInputSymbol,14) then
  begin
       if (CurrentInputSymbol=IFSym) then
       begin
         Get;
                                   nL1 := tab.NewNode(ntIf,nil, CurLine); nR1 := nL1; 
         _SemText(@nL1.pos);
       end;
       _Factor(nL2,nR2);
                                   if nL1<>nil then tab.MakeSeq(nL1,nR1,nL2,nR2)
                                   else begin nL1 := nL2; nR1 := nR2; end;
                                 
       while InSet(CurrentInputSymbol,15) do
       begin
         _Factor(nL2,nR2);
                                   tab.MakeSeq(nL1, nR1, nL2, nR2); 
       end;
  end
  else if InSet(CurrentInputSymbol,16) then
  begin
                                   nL1 := tab.NewNode(ntEps, nil, CurLine); nR1 := nL1; 
  end
  else SynError(8);
                                   if nL1=nil then //invalid start of Term
                                   begin nL1 := tab.NewNode(ntEps, nil, 0); nR1 := nL1; end; 
end;

procedure TCoco._Factor(var nL,nR: TNode);
                                 var name: String; isID, weak, undef: Boolean;
                                 sym: TSymbol; typ: TNodeType;
                                 pos: TSymbolRec;
                               
begin
                                 weak := False; nL := nil; nR := nil; 
  if (CurrentInputSymbol in [identSym, stringSym, WEAKSym]) then
  begin
       if (CurrentInputSymbol=WEAKSym) then
       begin
         Get;
                                 weak := True; 
       end;
       _Sym(name, isID);
                                 sym := tab.Symbols[name];
                                 if (sym=nil)and not IsID then
                                     sym := tab.Literals[name]; 
                                 undef := sym=nil;
                                 if undef then
                                    if isID  then
                                       sym := tab.NewSym(stNonterminal, name, 0)
                                    else if genScanner then
                                    begin
                                       sym := tab.NewSym(stTerminal, name, CurLine);
                                       dfa.MatchLiteral(sym.name, sym);
                                    end else begin  // undefined string in production
                                       SemError(226);
                                       sym := tab.eofSy;  // dummy
                                    end;

                                 typ := NodeTypeForSymType(sym.typ);
                                 if typ=ntUnknown then
                                     SemError(227);
                                 if weak then
                                   if typ=ntTerminal then typ := ntWeakTerminal
                                 else SemError(228);
                                 nL := tab.NewNode(typ, sym, CurLine);
                                 nR := nL;
                                 ClearSymbol(@pos);
                               
       if (CurrentInputSymbol=_lessSym) then
       begin
         _Attribs(@pos);
                                 if not isID then SemError(229); 
       end;
                                 if (not undef)and((pos.Beg<>-1)<>sym.hasAttrPos)  then
                                   SemError(222);
                                 nL.pos := pos;
                                 if undef and (pos.Beg<>-1) then sym.attrPos^ := pos;
                               
  end
  else if (CurrentInputSymbol=_lparenSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rparenSym);
  end
  else if (CurrentInputSymbol=_lbrackSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rbrackSym);
                                  tab.MakeOpt(nL,nR);  
  end
  else if (CurrentInputSymbol=_lbraceSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rbraceSym);
                                  tab.MakeIter(nL,nR); 
  end
  else if (CurrentInputSymbol=_lparen_pointSym) then
  begin
       _SemText(@pos);
                                  nL := tab.NewNode(ntSem,nil,CurLine); nR := nL;
                                 nL.pos := pos;
                               
  end
  else if (CurrentInputSymbol=ANYSym) then
  begin
       Get;
                                  nL := tab.NewNode(ntAny,nil,CurLine);  // p.set is set in tab.SetupAnys
                                  nR := nL;
                               
  end
  else if (CurrentInputSymbol=SYNCSym) then
  begin
       Get;
                                  nL := tab.NewNode(ntSync,nil, CurLine); nR := nL; 
  end
  else SynError(9);
end;



function TCoco.TokenToString(n: Integer): String;
const TokenStrings: array[0.._NOSYMB] of String = ('EOF'
	,'ident'	,'string'	,'badstring'	,'number'	,'"COMPILER"'
	,'"FRAME"'	,'"END"'	,'"CHARACTERS"'	,'"TOKENS"'	,'"HOMOGRAPHS"'
	,'"PRAGMAS"'	,'"COMMENTS"'	,'"IGNORECASE"'	,'"IGNORE"'	,'"PRODUCTIONS"'
	,'"."'	,'"="'	,'"+"'	,'"-"'	,'".."'
	,'"ANY"'	,'"CHR"'	,'"("'	,'")"'	,'"HOMOGRAPH"'
	,'"|"'	,'"CONTEXT"'	,'"["'	,'"]"'	,'"{"'
	,'"}"'	,'"FROM"'	,'"TO"'	,'"NESTED"'	,'"<"'
	,'">"'	,'"(."'	,'".)"'	,'"IF"'	,'"WEAK"'
	,'"SYNC"'  ,'not');
begin
  if n in [0.._NOSYMB] then
    Result := TokenStrings[n]
  else Result := '?';
end;

function TCoco.ErrorMessage(ErrorType, ErrorCode: Integer; const data: string): String;
begin
  case ErrorCode of
	1 : Result := 'this symbol not expected in Coco';
	2 : Result := 'this symbol not expected in TokenDecl';
	3 : Result := 'invalid TokenDecl';
	4 : Result := 'invalid SimSet';
	5 : Result := 'invalid SingleChar';
	6 : Result := 'invalid Sym';
	7 : Result := 'invalid TokenFactor';
	8 : Result := 'invalid Term';
	9 : Result := 'invalid Factor';

               
  200: Result := 'empty token not allowed';
  201: Result := Format('Template var "%s" declared twice',[data]);
  202: Result := 'empty token not allowed';
  203: Result := 'literal tokens must not contain blanks';
  204: Result := 'token might be empty';
  205: Result := Format('tokens %s cannot be distinguished',[data]);
  206: Result := 'character set contains more than 1 character';
  207: Result := 'comment delimiters may not be structured';
  208: Result := 'comment delimiters must be 1 or 2 characters long';
  209: Result := 'name does not match grammar name';
  210: Result := 'missing production for grammar name';
  211: Result := 'grammar symbol must not have attributes';
  212: Result := 'name declared twice';
  213: Result := 'character set must not be empty';
  214: Result := 'undefined name';
  215: Result := 'must be integer number <=127';
  216: Result := 'char = string[1]';
  217: Result := 'a literal must not be declared with a structure';
  218: Result := 'token string declared twice';
  219: Result := 'semantic action not allowed here';
  220: Result := 'undefined name';
  221: Result := 'this symbol kind not allowed on left side of production';
  222: Result := 'attribute mismatch between declaration and use of this symbol';
  223: Result := 'bad string in attributes';
  224: Result := 'bad string in semantic action';
  225: Result := 'missing end of previous semantic action';
  226: Result := 'undefined string in production';
  227: Result := 'this symbol kind is not allowed in a production';
  228: Result := 'only terminals may be weak';
  229: Result := 'a literal must not have attributes';
  230: Result := 'only literal could be homograph';
 
    else Result := inherited ErrorMessage(ErrorType, ErrorCode,data);
  end;
end;


procedure TCoco.ProcessPragmas;
begin
  case CurrentInputSymbol of
    WarnPragmaSym:
	begin
          if not SkipWarnSuppression then tab.WarnSuppression := LexStrings[1][3]='-'; 
	end;
    IGnoreWarnPragmaSym:
	begin
          SkipWarnSuppression := True; tab.WarnSuppression := False; 
	end;
  end;

end;


function TCoco.Execute: Boolean;
begin
  Reinit;
  _Coco;
  Result := Successful;
end;


function TCoco.CreateScanner: TBaseScanner;
begin
  Result := TCocoScanner.Create(Self);
  if CocoST=nil then
  begin
    CocoST := TStartTable.Create;
    with CocoST do
    begin
	  FillRange(65, 90, 1);  States[95] := 1;  FillRange(97, 122, 1);  FillRange(48, 57, 4);
	  States[34] := 11;  States[39] := 12;  States[47] := 5;  States[123] := 28;  States[46] := 29;
	  States[61] := 15;  States[43] := 16;  States[45] := 17;  States[40] := 30;  States[41] := 19;
	  States[124] := 20;  States[91] := 21;  States[93] := 22;  States[125] := 23;  States[60] := 24;
	  States[62] := 25;
    end;
    CocoLiterals := CreateLiterals(True,
	['COMPILER','FRAME','END','CHARACTERS','TOKENS','HOMOGRAPHS','PRAGMAS','COMMENTS','IGNORECASE','IGNORE','PRODUCTIONS'
		,'ANY','CHR','HOMOGRAPH','CONTEXT','FROM','TO','NESTED','IF','WEAK','SYNC'],
	[COMPILERSym,FRAMESym,ENDSym,CHARACTERSSym,TOKENSSym,HOMOGRAPHSSym,PRAGMASSym,COMMENTSSym,IGNORECASESym,IGNORESym
		,PRODUCTIONSSym,ANYSym,CHRSym,HOMOGRAPHSym,CONTEXTSym,FROMSym,TOSym,NESTEDSym,IFSym,WEAKSym,SYNCSym]
     );
  end;
  with TCocoScanner(Result) do
  begin
      
    noSym := _NOSYMB;
    StartState := CocoST;
    Literals := CocoLiterals;
  end;
end;


constructor TCoco.Create(AOwner: TComponent);
begin
  
  inherited;

  if Length(CocoSymSets)=0 then
  InitSymSets(CocoSymSets,[
    	{ 0} _EOFSYMB, identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _equalSym, _lparen_pointSym, -1,
	{ 1} CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, -1,
	{ 2} _EOFSYMB, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, -1,
	{ 3} identSym, stringSym, _lparenSym, _lbrackSym, _lbraceSym, -1,
	{ 4} identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _lparen_pointSym, -1,
	{ 5} _EOFSYMB, identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, ANYSym, _lparenSym, _barSym, _lbrackSym, _lbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{ 6} _EOFSYMB, identSym, stringSym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _equalSym, _lparen_pointSym, -1,
	{ 7} CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _rparenSym, _rbrackSym, _rbraceSym, TOSym, NESTEDSym, -1,
	{ 8} identSym, stringSym, badstringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _greaterSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{ 9} identSym, stringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _greaterSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{10} identSym, stringSym, badstringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _lparen_pointSym, _point_rparenSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{11} identSym, stringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _lparen_pointSym, _point_rparenSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{12} identSym, stringSym, _pointSym, ANYSym, _lparenSym, _rparenSym, _barSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{13} _pointSym, _rparenSym, _rbrackSym, _rbraceSym, -1,
	{14} identSym, stringSym, ANYSym, _lparenSym, _lbrackSym, _lbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{15} identSym, stringSym, ANYSym, _lparenSym, _lbrackSym, _lbraceSym, _lparen_pointSym, WEAKSym, SYNCSym, -1,
	{16} _pointSym, _rparenSym, _barSym, _rbrackSym, _rbraceSym
  ]); 
  SymSets := CocoSymSets;
  
end;

end.

